home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / simula / books / books.lha / kirkerud / arrayproc.sim next >
Text File  |  1993-08-16  |  9KB  |  257 lines
  1. begin
  2.  
  3.  
  4. % *********************************************
  5. % *                                           *
  6. % *    Proposed solution to exercise 6.15:    *
  7. % *                                           *
  8. % *********************************************
  9.  
  10.   procedure Min_max_in_array(arr, min_val, max_val);
  11.       name min_val, max_val;
  12.       integer array arr; 
  13.       integer min_val, max_val;
  14.     begin 
  15.       integer low_ind, high_ind, ind;
  16.       low_ind := lowerbound(arr, 1); high_ind := upperbound(arr, 1); 
  17.       min_val := maxint;  max_val := minint;
  18.       for ind := low_ind step 1 until high_ind do
  19.         begin
  20.           min_val := min(arr(ind), min_val);
  21.           max_val := max(arr(ind), max_val);
  22.         end;
  23.     end of Min_max_in_array;
  24.  
  25.   procedure Min_max_in_2dim_array(arr, min_val, max_val);
  26.       name min_val, max_val;
  27.       integer array arr; 
  28.       integer min_val, max_val;
  29.     begin 
  30.       integer low_ind1, high_ind1, low_ind2, high_ind2, ind1, ind2;
  31.       low_ind1 := lowerbound(arr, 1); high_ind1 := upperbound(arr, 1); 
  32.       low_ind2 := lowerbound(arr, 1); high_ind2 := upperbound(arr, 1); 
  33.       min_val := maxint;  max_val := minint;
  34.       for ind1 := low_ind1 step 1 until high_ind1 do
  35.         for ind2 := low_ind2 step 1 until high_ind2 do
  36.         begin
  37.           min_val := min(arr(ind1, ind2), min_val);
  38.           max_val := max(arr(ind1, ind2), max_val);
  39.         end;
  40.     end of Min_max_in_2dim_array;
  41.  
  42.  
  43. % *********************************************
  44. % *                                           *
  45. % *    Proposed solution to exercise 6.17:    *
  46. % *                                           *
  47. % *********************************************
  48.  
  49.   procedure Merge(A, B, C, a_high, b_high);
  50.       integer array A, B, C;
  51.       integer a_high, b_high;
  52.     begin
  53.       integer a_ind, b_ind, c_ind, next_from_A, next_from_B;
  54.       Boolean a_finished, b_finished;
  55.       a_ind := 1; next_from_A := A(a_ind); a_finished := false;
  56.       b_ind := 1; next_from_B := B(b_ind); b_finished := false;
  57.       c_ind := 0;
  58.       while not (a_finished and b_finished) do
  59.         begin ! a_finished will be true when all elements in A have
  60.               ! been merged into C, similarily with b_finished.
  61.               ! At this point, not both a_finished and b_finished. 
  62.               ! There must therefore be at least one element 
  63.               ! in A or B which have not found its place in C.
  64.               ! This is done as follows:  ;
  65.           c_ind := c_ind + 1;
  66.           if next_from_A < next_from_B then  
  67.             begin 
  68.               C(c_ind) := next_from_A; 
  69.             ! Find the next element in A:   ;
  70.               a_ind := a_ind + 1;  
  71.               if a_ind le a_high 
  72.                 then next_from_A := A(a_ind)
  73.                 else begin next_from_A := maxint; a_finished := true end;
  74.             end
  75.           else begin
  76.               C(c_ind) := next_from_B; 
  77.             ! Find the next element in B:   ;
  78.               b_ind := b_ind + 1;
  79.               if b_ind le b_high 
  80.                 then next_from_B := B(b_ind)
  81.                 else begin next_from_B := maxint; b_finished := true end;
  82.             end
  83.         end;
  84.     end of Merge;
  85.  
  86.  
  87.  
  88. % *********************************************
  89. % *                                           *
  90. % *  A procedure that may be used to test the *
  91. % *   procedures Min_max_in_array and Merge   *
  92. % *                                           *
  93. % *********************************************
  94.  
  95.   procedure test_array_proc(na, nb); integer na, nb;
  96.     begin
  97.  
  98.       integer array A(1 : na), B(1 : nb), C(1 : na + nb);
  99.       Boolean more_testing;
  100.     
  101.       procedure Give_help;
  102.         begin
  103.           write_line("Legal commands: ");
  104.           write_line("   r:  read array ");
  105.           write_line("   m:  test Merge ");
  106.           write_line("   x:  test Min_max_in_array ");
  107.           write_line("   s:  sort array ");
  108.           write_line("   w:  write arrays"); 
  109.           write_line("   q:  quit"); 
  110.         end of give_help;
  111.  
  112.       procedure read_array;
  113.         begin character arrchar;
  114.           arrchar := prompt_for_char("Read A or B? ");
  115.           if arrchar = 'A' then read_arr(A) else
  116.           if arrchar = 'B' then read_arr(B); 
  117.         end;
  118.     
  119.       procedure test_merge;
  120.         Merge(A, B, C, na, nb);
  121.     
  122.       procedure test_minmax;
  123.         begin character arrchar; integer min_val, max_val;
  124.           arrchar := prompt_for_char("Minmax for A, B or C? ");
  125.           if arrchar = 'A' then 
  126.             Min_max_in_array(A, min_val, max_val) else
  127.           if arrchar = 'B' then
  128.             Min_max_in_array(B, min_val, max_val) 
  129.          else
  130.             Min_max_in_array(C, min_val, max_val);
  131.          outtext("Minimum in "); outchar(arrchar); outtext(": "); outint(min_val,0);
  132.          outtext("  Maximum: "); outint(max_val,0); outimage;
  133.         end of test_findminmax;
  134.     
  135.       procedure sort_array;
  136.         begin character arrchar;
  137.           arrchar := prompt_for_char("Sort A or B? ");
  138.           if arrchar = 'A' then Quicksort(A, 1, na) else
  139.           if arrchar = 'B' then Quicksort(B, 1, nb);
  140.         end;
  141.     
  142.       procedure write_arrays;
  143.         begin
  144.           write_array("A", A);
  145.           write_array("B", B);
  146.           write_array("C", C);
  147.         end of write_arrays;
  148.  
  149.       write_line("Testing of Min_max_in_array and Merge:");
  150.       Give_help;
  151.  
  152.       more_testing := true;
  153.       while more_testing do
  154.         begin character c;
  155.           c := prompt_for_char("Write command> "); 
  156.           if c = 'r' then read_array   else
  157.           if c = 'm' then test_merge   else
  158.           if c = 'x' then test_minmax  else
  159.           if c = 's' then sort_array   else
  160.           if c = 'w' then write_arrays else
  161.           if c = 'q' then more_testing := false
  162.           else begin write_line("Unknown command"); Give_help end;
  163.         end;
  164.  
  165.     end test_array_proc;
  166.  
  167.  
  168. % *********************************************
  169. % *                                           *
  170. % *       The quicksort-procedure:            *
  171. % *                                           *
  172. % *********************************************
  173.  
  174.   procedure Quicksort(table, low_bound, high_bound);
  175.       integer array table;  integer low_bound, high_bound;
  176.     !  Sorts the elements in table(low_bound : high_bound) in non-decreasing order;
  177.   if low_bound < high_bound then
  178.   begin integer some_value, last_below, last_equal,  first_above, ind, x;
  179.     some_value  := table(low_bound);
  180.     last_below  := low_bound - 1;
  181.     last_equal  := low_bound;
  182.     first_above := high_bound + 1;
  183.     ind         := low_bound + 1;
  184.     while ind < first_above do
  185.       begin
  186.         x := table(ind);      
  187.         if x < some_value then
  188.           begin
  189.             last_below := last_below + 1;     last_equal := last_equal + 1;
  190.             table(ind) := table(last_below);  table(last_below) := x;
  191.             ind := ind + 1;
  192.           end else
  193.         if x = some_value then
  194.           begin last_equal := last_equal + 1;  ind := ind + 1 end
  195.         else begin
  196.             first_above := first_above - 1;
  197.             table(ind) := table(first_above);  table(first_above) := x;
  198.           end;
  199.       end;
  200.     Quicksort(table,   low_bound, last_below);
  201.     Quicksort(table, first_above, high_bound);
  202.   end of Quicksort;
  203.   
  204.  
  205.  
  206. % *********************************************
  207. % *                                           *
  208. % *       Some auxiliary procedures:          *
  209. % *                                           *
  210. % *********************************************
  211.  
  212.   procedure read_arr(arr); 
  213.       integer array arr;
  214.     begin integer array_length, ind;
  215.       array_length := upperbound(arr, 1);
  216.       for ind := 1 step 1 until array_length do
  217.         arr(ind) := prompt_for_int("Write next array-element> ");
  218.     end of read_arr;
  219.  
  220.   procedure write_array(arr_name, arr);
  221.       text arr_name; integer array arr;
  222.     begin integer arr_length, ind;
  223.       arr_length := upperbound(arr, 1);
  224.       outtext("The array "); outtext(arr_name); 
  225.       outtext(" has the following "); outint(arr_length, 0); 
  226.       outtext(" elements:"); outimage;
  227.       for ind := 1 step 1 until arr_length do
  228.         outint(arr(ind), 10);
  229.       outimage;
  230.     end of write_array;
  231.  
  232.   procedure write_line(line); text line;
  233.      begin outtext(line); outimage end;
  234.  
  235.   integer procedure prompt_for_int(prompt); text prompt;
  236.     begin
  237.       outtext(prompt); breakoutimage;
  238.       inimage; prompt_for_int := inint;
  239.     end;
  240.  
  241.   character procedure prompt_for_char(prompt); text prompt;
  242.     begin
  243.       outtext(prompt); breakoutimage;
  244.       inimage; prompt_for_char := inchar;
  245.     end;
  246.  
  247.  
  248. % *********************************************
  249. % *                                           *
  250. % *   An invocation of the test-procedure:    *
  251. % *                                           *
  252. % *********************************************
  253.  
  254.   test_array_proc(6, 6);
  255.  
  256. end
  257.